home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / _PD_TOOLS_MARQ.pdrx < prev    next >
Text File  |  1992-06-22  |  6KB  |  269 lines
  1. /*
  2. @N
  3.  
  4. */
  5. msg = PDSetup.rexx(2,0)
  6. units = getclip(pds_units)
  7. if msg ~= 1 then exit_msg(msg)
  8. cr = '0a'x
  9.  
  10. objlist.1 = "isclosed"
  11. objlist.1.1 = "Close objects"
  12. objlist.2 = "islocked"
  13. objlist.2.1 = "Locked Objects"
  14. objlist.3 = "isgrouped"
  15. objlist.3.1 = "Grouped Objects"
  16. objlist.4 = "iscompound"
  17. objlist.4.1 = "Compounded Objects"
  18. objlist.5 = "isbitmap"
  19. objlist.5.1 = "Bitmap Objects"
  20. objlist.6 = "isepsf"
  21. objlist.6.1 = "EPSF objects"
  22. objlist.7 = "isstructgraphic"
  23. objlist.7.1 = "Structured Graphics objects"
  24. objlist.8 = "isellipse"
  25. objlist.8.1 = "Ellipses"
  26. objlist.9 = "iscircle"
  27. objlist.9.1 = "Circles"
  28. objlist.10 = "isbezier"
  29. objlist.10.1 = "Beziers"
  30. objlist.11 = "isgrid"
  31. objlist.11.1 = "Grid Objects"
  32. objlist.12 = "istext"
  33. objlist.12.1 = "Text Objects"
  34. objlist.13 = "istexthole"
  35. objlist.13.1 = "Text Holes"
  36. objlist.14 = "istransparent"
  37. objlist.14.1 = "Transparent Objects"
  38. objlist.15 = "ishidden"
  39. objlist.15.1 = "Hidden objects"
  40.  
  41. objlist = ''
  42.  
  43. do i = 1 to 15
  44.  objlist = objlist || cr || objlist.i.1
  45.  interpret compress(objlist.i.1)"="objlist.i
  46. end
  47.  
  48. objlist = substr(objlist, 2)
  49.  
  50. selection = "By Size"cr"By Position"cr"By Color"cr"By Layer"cr"By Object Type"
  51. selection = pdm_SelectFromList("Select object..", 20, 5,1,selection)
  52. if selection = '' then exit_msg()
  53.  
  54. i = 0
  55.  
  56. do while selection ~= ''
  57.  parse var selection function '0a'x selection
  58.  function = compress(function)
  59.  i = i + 1
  60.  interpret vfunc.i" = "function"()"
  61. end
  62.  
  63. if pdm_SelFirstObj() ~ = 0 then
  64. do
  65.  if ~pdm_Inform(2,"Add objects to current selection?", "No", "Yes") then
  66.   call pdm_UnSelectobj()
  67. end
  68.  
  69. cobj = pdm_PageFirstobj()
  70. num = 0
  71.  
  72. do while cobj ~= 0
  73.  switch = 1
  74.  num = num + 1
  75.  
  76.  do x = 1 to i
  77.   interpret "rval = "vfunc.x
  78.   switch = switch & rval
  79.   if ~rval then break
  80.  end
  81.  
  82.  if switch then call pdm_SelectAnother(cobj)
  83.  cobj = pdm_PageNextObj(cobj)
  84. end
  85.  
  86. exit_msg()
  87.  
  88. exit_msg: procedure expose units
  89. do
  90.  parse arg message
  91.  
  92.  if message ~= '' then call pdm_Inform(1,message,)
  93.  call pdm_AutoUpdate(1)
  94.  call pdm_SetUnits(units)
  95.  exit
  96. end
  97.  
  98.  
  99. CheckSize: procedure expose cobj units
  100. do
  101.  parse arg minw, minh, maxw, maxh
  102.  
  103.  size = pdm_GetObjVisSize(cobj)
  104.  width = word(size, 1)
  105.  height = word(size, 2)
  106.  
  107.  if ((width >= minw) & (width <= maxw)) & ((height >= minh) & (height <= maxh)) then
  108.   return(1)
  109.  else
  110.   return(0)
  111.  
  112. end
  113.  
  114. CheckPos: procedure expose cobj units
  115. do
  116.  parse arg left, top, right, bottom
  117.  
  118.  pos = pdm_GetObjVisPosn(cobj)
  119.  size = pdm_GetObjVisSize(cobj)
  120.  l = word(pos, 1)
  121.  t  = word(pos, 2)
  122.  r = word(size, 1) + l
  123.  b = word(size, 2) + t
  124.  
  125.  if (l >= left) & (r <= right) & (t >= top) & (b <= bottom) then
  126.   return(1)
  127.  return(0)
  128. end
  129.  
  130. BySize: procedure expose units
  131. do
  132.  cr = '0a'x
  133.  
  134.  form = "Min Width"cr"Min Height"cr"Max Width"cr"Max Height"
  135.  size = pdm_GetForm("Enter object size..", 8, form)
  136.  if size = '' then exit_msg()
  137.  parse var size minw '0a'x minh '0a'x maxw '0a'x maxh
  138.  
  139.  if ~(datatype(minw, n) & datatype(minh, n) & datatype(maxw, n) & datatype(maxh, n)) then
  140.   exit_msg("Invalid Entry")
  141.  
  142.  if units >2 then
  143.  do
  144.   minw = pdm_ConvertUnits(units, 1, minw)
  145.   minh = pdm_ConvertUnits(units, 1, minh)
  146.   maxw = pdm_ConvertUnits(units, 1, maxw)
  147.   maxh = pdm_ConvertUnits(units, 1, maxh)
  148.  end
  149.  
  150.  return "CheckSize("minw","minh","maxw","maxh")"
  151. end
  152.  
  153. ByPosition: procedure expose units
  154. do
  155.  
  156.  cr = '0a'x
  157.  
  158.  form = "Left"cr"Top"cr"Right"cr"Bottom"
  159.  size = pdm_GetForm("Enter object boundry..", 8, form)
  160.  if size = '' then exit_msg()
  161.  parse var size minw '0a'x minh '0a'x maxw '0a'x maxh
  162.  
  163.  if ~(datatype(minw, n) & datatype(minh, n) & datatype(maxw, n) & datatype(maxh, n)) then
  164.   exit_msg("Invalid Entry")
  165.  
  166.  if units >2 then
  167.  do
  168.   minw = pdm_ConvertUnits(units, 1, minw)
  169.   minh = pdm_ConvertUnits(units, 1, minh)
  170.   maxw = pdm_ConvertUnits(units, 1, maxw)
  171.   maxh = pdm_ConvertUnits(units, 1, maxh)
  172.  end
  173.  
  174.  return "CheckPos("minw","minh","maxw","maxh")"
  175. end
  176.  
  177. ByColor: procedure expose colorlist units
  178. do
  179.  lc = pdm_GetLineColor()
  180.  clist = pdm_SetLineColor()
  181.  call pdm_SetLineColor(,lc)
  182.  if clist = '' then exit_msg()
  183.  
  184.  return("CheckColor('"clist"')")
  185.  
  186. end
  187.  
  188. CheckColor: procedure expose cobj units
  189. do
  190.  parse arg clist
  191.  
  192.  if pdm_GetLineWeight(cobj) ~= 0 & pos(pdm_GetLineColor(cobj), clist) ~= 0 then return(1)
  193.  
  194.  fpattern = pdm_GetFillPattern(cobj) 
  195.  parse var fpattern type '0a'x c1 '0a'x c2 '0a'x junk
  196.  
  197.  if type = 0 then return(0)
  198.  if type >= 1 & pos(c1, clist) ~= 0 then return(1)
  199.  if type > 1 & pos(c2, clist) ~= 0 then return(1)
  200.  
  201.  return(0)
  202.  
  203. end
  204.  
  205. ByObjectType: units
  206. do
  207.  
  208.  types = pdm_SelectFromList("Types of objects..", 20, 8, 1, objlist)
  209.  if types = '' then exit_msg()
  210.  
  211.  typelist = ''
  212.  
  213.  do while types ~= ''
  214.   parse var types type '0a'x types
  215.   type = value(compress(type))
  216.   typelist = typelist" "type
  217.  end
  218.  
  219.  return("CheckType('"typelist"')")
  220.  
  221. end
  222.  
  223. CheckType: procedure expose cobj units
  224. do
  225.  parse arg types
  226.  
  227.  
  228.  do w = 1 to words(types)
  229.   wrd = word(types, w)
  230.   interpret "rval = "wrd"("cobj")"
  231.   if rval then return(1)
  232.  end
  233.  return(0)
  234.  
  235. end
  236.  
  237. ByLayer: procedure expose units
  238. do
  239.  cr = '0a'x
  240.  max = pdm_NumPageObjs()
  241.  form = "From:1"cr"To:"max
  242.  layers = pdm_GetForm("Enter object layer range..", 8, form)
  243.  if layers = '' then exit_msg()
  244.  
  245.  parse var layers from '0a'x tolayer
  246.  
  247.  if ~(datatype(from, n) & datatype(tolayer, n)) then 
  248.   exit_msg("Invalid Entry")
  249.  
  250.  if from < 1 | from > max | tolayer < 1 | tolayer > max then
  251.   exit_msg("Invalid Entry")
  252.  
  253.  if tolayer < from  then
  254.  do
  255.   temp = from
  256.   form = tolayer
  257.   tolayer = temp
  258.  end
  259.  
  260.  return("CheckLayer("from","tolayer")")
  261.  
  262. end
  263.  
  264. CheckLayer: procedure expose num units
  265. do
  266.  parse arg from, tolayer
  267.  
  268.  return(num >= from & num <= tolayer)
  269. end